home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / HD_INST.M < prev    next >
Encoding:
Text File  |  1990-10-18  |  7.6 KB  |  270 lines
  1. MODULE HD_INST;
  2.  
  3. (*
  4.  * Kopiert alle Dateien beliebig vieler Disks in ein Verzeichnis.
  5.  * Das Datum wird beibehalten, die Attribute werden jedoch nicht übertragen.
  6.  * Doppelte oder bereits vorhandene Dateien werden nicht nochmal kopiert.
  7.  *
  8.  * Das Programm wird lediglich mit "M2Init" gelinkt!
  9.  *
  10.  * TT 01.10.89
  11.  *)
  12.  
  13. IMPORT SimpleError, GEMDOSIO;
  14.  
  15. IMPORT VT52;
  16.  
  17. FROM Storage IMPORT MemAvail, ALLOCATE;
  18.  
  19. FROM MOSGlobals IMPORT fFileExists, Drive, Date, Time;
  20.  
  21. FROM InOut IMPORT Write, WriteLn, WriteString, WriteInt, Read, ReadString,
  22.         WritePg, BusyRead, FlushKbd;
  23.  
  24. FROM Files IMPORT GetStateMsg, File, Access, Open, Close, Remove, State,
  25.         ResetState, GetDateTime, SetDateTime, Create, ReplaceMode;
  26.  
  27. FROM Binary IMPORT FileSize, ReadBytes, WriteBytes;
  28.  
  29. FROM Directory IMPORT MakeFullPath, DirQuery, DirEntry, DefaultDrive,
  30.         SetDefaultDrive, CreateDir, QueryFiles, QueryAll, subdirAttr,
  31.         FileAttrSet, PathExists;
  32.  
  33. FROM FileNames IMPORT ValidatePath, SplitPath;
  34.  
  35. FROM Strings IMPORT String, Empty, Append, Assign, Length, Space, Upper, Concat;
  36.  
  37. FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  38.  
  39. FROM EasyGEM0 IMPORT HideMouse, ShowMouse;
  40. FROM EasyGEM1 IMPORT SelectMask, SelectFile;
  41. FROM GEMEnv IMPORT RC, InitGem, DeviceHandle;
  42.  
  43.  
  44. VAR subdirs, aborted, ok: BOOLEAN;
  45.     res: INTEGER;
  46.     name, destpath: String;
  47.     f1, f2: File;
  48.     buf: ADDRESS;
  49.     buflen: LONGCARD;
  50.     ch: CHAR;
  51.     msg: String;
  52.  
  53. PROCEDURE showError (res: INTEGER);
  54.   VAR msg: String;
  55.   BEGIN
  56.     WriteLn;
  57.     WriteString ('******* Fehler beim Kopieren: ');
  58.     GetStateMsg (res, msg);
  59.     WriteString (msg);
  60.     WriteString (' *******');
  61.     WriteLn;
  62.   END showError;
  63.  
  64. PROCEDURE error (VAR f: File; s: ARRAY OF CHAR): BOOLEAN;
  65.   VAR  msg: String;
  66.   BEGIN
  67.     IF State (f) < 0 THEN
  68.       WriteLn;
  69.       WriteString ('****** ');
  70.       WriteString (s);
  71.       WriteString (': ');
  72.       GetStateMsg (State (f), msg);
  73.       WriteString (msg);
  74.       WriteString (' ******');
  75.       WriteLn;
  76.       ResetState (f);
  77.       RETURN TRUE
  78.     ELSE
  79.       RETURN FALSE
  80.     END
  81.   END error;
  82.  
  83.  
  84. PROCEDURE copyFile (REF path: ARRAY OF CHAR; entry: DirEntry): BOOLEAN;
  85.  
  86.   VAR lastpath, source, dest: String;
  87.       n, n1: LONGCARD;
  88.       d: Date; t: Time;
  89.  
  90.   BEGIN
  91.     IF subdirAttr IN entry.attr THEN
  92.       IF entry.name[0] # '.' THEN
  93.         (* Ordner durchgehen *)
  94.         Concat (path, entry.name, source, ok);
  95.         Append ('\*.*', source, ok);
  96.         lastpath:= destpath;
  97.         Append (entry.name, destpath, ok);
  98.         CreateDir (destpath, res); (* wenn schon existiert, Fehler ignorieren *)
  99.         Append ('\', destpath, ok);
  100.         DirQuery (source, QueryAll, copyFile, res);
  101.         destpath:= lastpath;
  102.         (* Falls Dateien noch offen, dann nun löschen *)
  103.         Remove (f1);
  104.         Remove (f2);
  105.         IF res < 0 THEN
  106.           showError (res);
  107.           aborted:= TRUE;
  108.           RETURN FALSE
  109.         ELSIF aborted THEN
  110.           RETURN FALSE
  111.         END
  112.       END;
  113.       RETURN TRUE
  114.     ELSE
  115.       (*
  116.        * Wenn Fehler beim Lesen auftritt, wird mit dem nächsten File
  117.        * weitergemacht, bei Fehlern beim Schreiben wird abgebrochen.
  118.        *)
  119.       Concat (path, entry.name, source, ok);
  120.       Open (f1, source, readOnly);
  121.       IF error (f1, source) THEN RETURN TRUE END;
  122.       Concat (destpath, entry.name, dest, ok);
  123.       Create (f2, dest, writeOnly, noReplace);
  124.       IF State (f2) = fFileExists THEN
  125.         (* existiert bereits *)
  126.         Open (f2, dest, readOnly);
  127.         IF FileSize (f1) <> FileSize (f2) THEN
  128.           WriteLn;
  129.           WriteString ('****** ');
  130.           WriteString (dest);
  131.           WriteString (': Verschiedene Dateien gleichen Namens ******');
  132.           WriteLn;
  133.           Close (f1);
  134.           Close (f2);
  135.           RETURN TRUE
  136.         ELSE
  137.           Close (f1);
  138.           Close (f2);
  139.           RETURN TRUE
  140.         END
  141.       ELSIF error (f2, dest) THEN
  142.         aborted:= TRUE;
  143.         RETURN FALSE
  144.       ELSE
  145.         n:= buflen;
  146.         GetDateTime (f1, d, t);
  147.         LOOP
  148.           ReadBytes (f1, buf, n, n);
  149.           IF error (f1, source) THEN RETURN TRUE END;
  150.           IF n = 0L THEN EXIT END;
  151.           WriteBytes (f2, buf, n);
  152.           IF error (f2, dest) THEN aborted:= TRUE; RETURN FALSE END;
  153.         END;
  154.         Close (f2);
  155.         Close (f1);
  156.         Open (f2, dest, readOnly);
  157.         SetDateTime (f2, d, t);
  158.         Close (f2);
  159.         RETURN TRUE
  160.       END
  161.     END
  162.   END copyFile;
  163.  
  164. VAR dev: DeviceHandle;
  165.  
  166. BEGIN
  167.   InitGem (RC, dev, ok);
  168.   HideMouse;
  169.   WritePg;
  170.   WriteString ('Installation des Megamax Modula-2 auf Festplatte'); WriteLn;
  171.   WriteLn;
  172.   WriteString ('Gleich können Sie den Ordner, in den das System kopiert werden soll,'); WriteLn;
  173.   WriteString ('mit dem GEM-Datei-Selektor auswählen. Klicken Sie dann auf OK.'); WriteLn;
  174.   WriteString ('Ein Klick auf ABBRUCH bricht die Installation ab.'); WriteLn;
  175.   WriteLn;
  176.   WriteString ('Auf der Ziel-Partition müssen noch ca. 3.5 MB frei sein.'); WriteLn;
  177.   WriteLn;
  178.   WriteString ('Drücken Sie nun eine Taste, um das Ziel-Verzeichnis auszuwählen...'); WriteLn;
  179.   FlushKbd;
  180.   Read (ch);
  181.  
  182.   SelectMask:= 'C:\';
  183.   REPEAT
  184.   
  185.     name:= '';
  186.     SelectFile ('Wähle Ziel-Verzeichnis', name, ok);
  187.     WritePg;
  188.     IF NOT ok THEN RETURN END;
  189.     SplitPath (name, destpath, name);
  190.     MakeFullPath (destpath, res);
  191.     
  192.     IF name [0] # 0C THEN
  193.       (* Verzeichnis anlegen *)
  194.       WriteLn;
  195.       WriteString ('Verzeichnis wird angelegt...');
  196.       Append (name, destpath, ok);
  197.       CreateDir (destpath, res);
  198.       ValidatePath (destpath);
  199.       WriteLn;
  200.       IF res < 0 THEN
  201.         WriteString ('Fehler beim Anlegen des Verzeichnisses: ');
  202.         GetStateMsg (res, msg);
  203.         WriteString (msg);
  204.         WriteLn;
  205.         WriteString ('Taste...');
  206.         FlushKbd;
  207.         Read (ch);
  208.         WriteLn;
  209.       END
  210.     END;
  211.     
  212.   UNTIL PathExists (destpath);
  213.   
  214.   WriteLn;
  215.   WriteString ('Der Ziel-Pfad ist: ');
  216.   WriteString (destpath);
  217.   WriteLn;
  218.   WriteLn;
  219.  
  220.   buflen:= MemAvail () - $10000;
  221.   ALLOCATE (buf, buflen);
  222.  
  223.   WriteString ('Zum Installieren müssen Sie im Folgenden die vier mitgelieferten'); WriteLn;
  224.   WriteString ('Disketten (oder Kopien davon) in beliebiger Reihenfolge bei Aufforderung'); WriteLn;
  225.   WriteString ('einlegen. Danach können Sie den Vorgang abbrechen.'); WriteLn;
  226.   WriteString ('Es schadet nichts, wenn Sie versehentlich dieselbe Diskette mehrmals kopieren!'); WriteLn;
  227.  
  228.   LOOP
  229.     WriteLn;
  230.     WriteString ('Legen Sie nun die nächste Diskette ein und drücken Sie dann >Return<'); WriteLn;
  231.     WriteString ('Oder drücken Sie >Esc< zum Beenden.'); WriteLn;
  232.     FlushKbd;
  233.     WriteString (VT52.Seq [VT52.cursorOn]);
  234.     REPEAT
  235.       BusyRead (ch);
  236.       IF ch = 33C THEN
  237.         (* Programmende *)
  238.         WriteString (VT52.Seq [VT52.cursorOff]);
  239.         EXIT
  240.       END;
  241.     UNTIL ch = 15C;
  242.     WriteString (VT52.Seq [VT52.cursorOff]);
  243.     WriteLn;
  244.  
  245.     WriteString ('Diskette wird kopiert...');
  246.     WriteLn;
  247.     aborted:= FALSE;
  248.     IF DefaultDrive () > drvB THEN
  249.       (* wenn nicht von A: oder B: gestartet, dann A: als Source-LW nehmen *)
  250.       SetDefaultDrive (drvA)
  251.     END;
  252.     DirQuery ('\*.*', QueryAll, copyFile, res);
  253.     (* Falls Dateien noch offen, dann nun löschen *)
  254.     Remove (f1);
  255.     Remove (f2);
  256.     IF res < 0 THEN
  257.       showError (res);
  258.       aborted:= TRUE
  259.     END;
  260.     IF aborted THEN
  261.       WriteString ('Kopiervorgang abgebrochen.');
  262.       WriteLn;
  263.     ELSE
  264.       WriteLn;
  265.       WriteString ('Kopiervorgang erfolgreich durchgeführt.');
  266.       WriteLn;
  267.     END
  268.   END;
  269. END HD_INST.
  270.